home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BMUG Revelations
/
BMUG Revelations.toast
/
Programming
/
Programming Languages
/
Yerk 3.64
/
Supplement
/
Demo Folder
/
grDemo
< prev
next >
Wrap
Text File
|
1993-06-25
|
7KB
|
187 lines
\ grdemo - source for Curves, a simple Yerk application
\ 11/04/84 CBD Version 1
\ 12/21/84 cbd simplified design based on new control classes
\ 2/18/84 cbd final for release 1.0
\ Define a class of special vertical scroll bars that
\ always show digital values for their thumb settings.
:CLASS VSCtl <Super vScroll
Rect readOut \ visible rect around readout value
Rect viewReadOut \ view rect for readout number is inset by 4 pixels.
\ update the digital readout of the thumb value
:M DISPLAY: GetTopX: viewReadOut getBotY: viewReadOut 1- gotoxy
-curs clear: viewReadOut Get: super 3 .R ;M
\ redraw the readOut rect and display the value inside
:M DRAW: draw: readout display: self ;M
\ ( val -- ) put new thumb value, draw the readout number
:M PUT: put: super display: self ;M
\ Build new scroll bar - window must be created 1st
:M NEW: { left top len wind -- } left top len wind
New: Super 1 tmode 9 tsize 1 tfont
\ calculate the coordinates for the readOut rectangles
left 4- top len + 4+ dup -> len
left 20 + len 20 + put: readOut draw: readOut
get: readOut put: viewReadOut 3 3 inset: viewReadOut ;M
;CLASS
\ now, build three instances of class vSctl. These will be the
\ three vertical scroll bars for Curves.
VSctl Vs1 \ three scroll bars for control of
VSctl Vs2 \ graphics parameters by the user
VSctl Vs3
\ assign constants to the window corners, so that we can change
\ the size of the window and the length of the scroll bars will be
\ adjusted automatically. These constants relate to the global
\ coordinates of the Macintosh screen.
40 Value gwL
60 Value gwT
470 Value gwR
290 Value gwB
gwB gwT - 80 - Value vsLen \ len of scroll bars
\ Define a subclass of CtlWind containing a drawing pane.
\ The window will be a RoundDoc, draggable, non-growable.
:CLASS grWind <Super CtlWind
Rect thePane \ this is where we'll draw the graphics
\ Create a new grWind with rounded corners and title passed by caller
:M NEW: { taddr tlen -- } gwL gwT gwR gwB put: tempRect
tempRect tAddr tLen rndWind
true False New: super
grayRgn true setDrag: self ;M \ visible, no close box
\ handle an update event for this window
:M DRAW: set: self draw: vs1 draw: vs2 draw: vs3
(abs) call BeginUpdate (abs) call drawControls
clear: thePane draw: thePane
watchCurs \ show the watch cursor while drawing
clip: thePane exec: draw \ clip to the pane and draw
arrowCurs
(abs) call EndUpdate
clip: contRect \ clip back to entire window
\ cause the scroll bars to draw their readouts
;M
\ set defaults appropriate to this class
:M CLASSINIT: ClassInit: super \ set window class defaults
4 15 320 220 put: thePane ;M
;CLASS
\ instantiate grWind to create the Curves demo window.
grWind dwind
scon dTitle "Yerk Curves" \ title for dWind
\ set the current GrafPort to fWind so that we can see what's
\ going on during the compilation.
set: fwind
\ ( -- p1 p2 p3 ) fetch the drawing parameters from the three scroll bars.
: @dParms get: vs1 get: vs2 get: vs3 ;
\ ( -- ) define the 4 draw: handlers, 1 for each type of drawing.
: Spiral @dparms PutRange: Bic spiral: bic ;
: spin @dparms putRange: anna spin: anna ;
: Lj @dparms putRange: bic lj: bic ;
: dragon @dparms putRange: bic home: bic
get: vs1 dragon: bic ; \ dragon requires start val on stack
\ store new parameter ranges for the three scroll bars.
: !ranges { max1 max2 max3 -- }
1 max1 putRange: vs1 1 max2 putRange: vs2
1 max3 putRange: vs3 ;
\ send the New: message to the window and scroll bars.
\ this creates them within the Toolbox and displays them.
: newObjs close: fWind dTitle New: dWind
340 40 vsLen dWind new: vs1
370 40 vsLen dWind new: vs2
400 40 vsLen dWind new: vs3 ;
scon ab1 "Curves was written in Yerk"
scon ab2 "by Charles B. Duff"
scon ab3 "of Kriya Systems, Inc."
: about 0 tfont 0 tmode 12 tsize
8 40 Gotoxy ab1 type
cr ab2 type cr ab3 type
initFont ;
\ tell the two Pen objects where to center themselves
\ when they do a Home: operation. Because these values will be retained
\ in the pen objects when we do a SAVE, they can be set
\ at compile time.
150 120 center: bic
150 120 center: anna
\ Define the actions for the various control parts.
\ each action handler executes a deferred get: on the object whose
\ address is on the method stack. Since the handler was called from
\ the Exec: method of a vScroll object, the scroll bar's address
\ will be on the top of the mstack. The handler then modifies the
\ value of the thumb, and causes thePane in dWind to be redrawn
\ be adding its area to the current region.
: doThumb update: dWind ;
: doPgUp get: myCtl 10 - put: myCtl update: dWind ;
: doPgDn get: myCtl 10 + put: myCtl update: dWind ;
: doLnUp get: myCtl 1- put: myCtl update: dWind ;
: doLnDn get: myCtl 1+ put: myCtl update: dWind ;
'c lj setdraw: dwind
5 'cfas doLnUp doLnDn doPgUp doPgDn doThumb actions: vs1
5 'cfas doLnUp doLnDn doPgUp doPgDn doThumb actions: vs2
5 'cfas doLnUp doLnDn doPgUp doPgDn doThumb actions: vs3
\ define the menu for this application. AppleMen is already there.
5 Menu Grafmen
\ Define the menu handler words. Each one sets a new handler
\ for dWind's DRAW method, and then sets appropriate ranges and
\ titles for the scroll bars, and causes an update event.
( do Lissajous curves )
: doLiss mitem checkOne: theMenu 'c lj setdraw: dwind 200 200 179 !ranges update: dwind ;
( do Spirals )
: doSpiral mitem checkOne: theMenu 'c spiral setdraw: dwind 10 20 179 !ranges update: dwind ;
( do spinPolys )
: doSpin mitem checkOne: theMenu 'c spin setdraw: dwind 8 10 179 !ranges update: dwind ;
( do Dragon curves )
: doDrag mitem checkOne: theMenu 'c dragon setdraw: dwind 11 12 179 !ranges update: dwind ;
( set max reps in bic )
: setReps 300 putMax: bic 100 putMax: anna ;
: sayonara bye ;
\ fill menus with handlers
2 'cfas about null 1 put: appleMen
5 'cfas doLiss doSpiral doSpin doDrag bye 128 put: grafMen
\ get the new menubar from the resource file "demo.rsrc" and start
\ with 'lissajous' draws, so check the first menu item
: getGRMenu applemen grafMen 2 init: menubar 1 check: grafMen ;
\ startup word for the turtle graphics demo
: dStart " demo.rsrc" openresfile
getGRMenu newobjs
150 120 center: bic 150 120 center: anna
setReps
200 200 179 !ranges update: dwind \ don't call 'doliss' because mitem and themenu aren't set
-echo -curs
BEGIN key drop AGAIN ; \ just loop and listen to events